Delphi Informant Complete 1995 - 2000/Delphi Informant Complete 1995 to 2000.iso/Delphi Informant Magazine Complete Works SOURCE CODE 1998.rar/1998/Sep/di9809jp/BlastServer/SendMsg.pas

Pascal/Delphi Source File | 1998-03-06 | 5KB | 201 lines

unit SendMsg;

interface

uses
  Classes, Stdctrls, Windows, Winsock2;

const

 MaxAddrStr = 16;

type
  TWorkMsg = array[0..MAXGETHOSTSTRUCT -1] of char;

  TMCOptions = record
                TTL,
                Port          : Integer;
                Address       : String;
               end;

  TMultiCast = record
                imr_multiaddr : TInAddr;   // IP multicast address of group */
                imr_interface : TInAddr;   // local IP address of interface */
               end;

  TSendMsgThrd = class(TThread)
  private
    { Private declarations }
    Multicast  : TMultiCast;
    Msg      : String;
    Started  : Boolean;
    wsaData  : TWSADATA;
    sktBlast : TSocket;
    LocalAddr,
    RemoteAddr : TSockAddrIn;
    LoopBackFlag : BOOL;
    MCOptions  : TMCOptions;
    Memo       : TMemo;
    function  Start : Boolean;
    procedure DisplayMsg;
    procedure CleanUp(Sender : TObject);
    procedure BlastMsg;
    procedure Execute; override;
  public
   constructor Create(MsgMemo : TMemo; Options : TMCOptions);
  end;


var
 SendMsgThrd : TSendMsgThrd;

implementation

 Uses
  Main, SysUtils;

 const
  WS2HighVersion = 2;
  WS2LowVersion  = 2;



   function TSendMsgThrd.Start : Boolean;
   var
    VerReqd : WordRec;
   begin
    with VerReqd do
    begin
     Hi := WS2HighVersion;
     Lo := WS2LowVersion;
    end;
    Result := WSAStartUp(Word(VerReqd), wsaData) = 0;
   end;

   procedure TSendMsgThrd.DisplayMsg;
   begin
    frmMain.MemStatusMsg.Lines.Add(Msg);
   end;

   procedure TSendMsgThrd.CleanUp(Sender : TObject);
   begin
    if Started then
    begin
     closesocket(sktBlast);
     WSACleanUp;
    end;
   end;

   procedure TSendMsgThrd.BlastMsg;
   var
    Size : Byte;
    sktRes : Integer;
    WorkMsg : array[0..MAXGETHOSTSTRUCT-1] of char;
    Buffer : PChar;
   begin
    with RemoteAddr do
    begin
     sin_family       := AF_INET;
     sin_addr.s_addr  := inet_addr(pchar(MCOptions.Address));
     sin_port         := htons(MCOptions.Port);
    end;
    Size             := Memo.GetTextLen;
    Inc(Size);
    Buffer := NIL;
    try
     GetMem(Buffer, Size);
     Memo.GetTextBuf(WorkMsg,SizeOf(WorkMsg));
     sktRes := sendto(sktBlast, WorkMsg, SizeOf(WorkMsg), 0, TSockAddrIn(RemoteAddr), SizeOf(RemoteAddr));
     if sktRes = SOCKET_ERROR then
     begin
      Msg := Concat('Call to sendto failed! Error ', IntToStr(WSAGetLastError));
      Synchronize(DisplayMsg);
      closesocket(sktBlast);
      Exit;
     end;
    finally
     FreeMem(Buffer, Size);{Frees memory allocated to Buffer}
    end;
   end;

   constructor TSendMsgThrd.Create(MsgMemo : TMemo; Options : TMCOptions);
   var
    sktRes : Integer;
   begin
    inherited Create(TRUE);
    FreeOnTerminate := TRUE;
    OnTerminate := CleanUp;
    Started := Start;
    if not Started then
    begin
     Msg := 'Cannot load Winsock 2.0!';
     Synchronize(DisplayMsg);
     Exit;
    end;
    Memo := TMemo.Create(NIL);
    Memo := MsgMemo;
    MCOptions := Options;
    sktBlast := socket(AF_INET, SOCK_DGRAM, 0);
    if sktBlast = INVALID_SOCKET then
    begin
     Msg := Concat('Error creating datagram socket! Error ',IntToStr(WSAGetLastError));
     Synchronize(DisplayMsg);
     Exit;
    end;
// Bind the datagram socket
    with LocalAddr do
    begin
     sin_family := AF_INET;
     sin_addr.s_addr := htonl(INADDR_ANY); // any old interface
     sin_port := 0;
    end;
    sktRes := bind(sktBlast,LocalAddr, SizeOf(TSockAddrIn));
    if sktRes = SOCKET_ERROR then
    begin
     Msg := Concat('bind failed! Error ', IntToStr(WSAGetLastError));
     Synchronize(DisplayMsg);
     closesocket(sktRes);
     Exit;
    end;
// Join the multicast group using setsockopt
    with Multicast do
    begin
     imr_multiaddr.s_addr  := inet_addr(Pchar(MCOptions.Address));// IP multicast address of group *///MCAddrStr
     imr_interface.s_addr  := INADDR_ANY;// local IP address of interface
    end;
    sktRes := setsockopt(sktBlast, IPPROTO_IP, IP_ADD_MEMBERSHIP, pchar(@multicast), SizeOf(multicast));
    if sktRes = SOCKET_ERROR then
    begin
     Msg := Concat('setsockopt failed! Error ', IntToStr(WSAGetLastError));
     Synchronize(DisplayMsg);
     closesocket(sktBlast);
     Exit;
    end;
// Set IP TTL by using setsockopt
    sktRes := setsockopt(sktBlast, IPPROTO_IP, IP_MULTICAST_TTL, pchar(@MCOptions.TTL), SizeOf(MCOptions.TTL));
    if sktRes = SOCKET_ERROR then
    begin
     Msg := Concat('setsockopt failed! Error ' + IntToStr(WSAGetLastError));
     Synchronize(DisplayMsg);
     closesocket(sktBlast);
     Exit;
    end;
/// Disable loopback
    LoopBackFlag := FALSE;
    sktRes := setsockopt(sktBlast, IPPROTO_IP, IP_MULTICAST_LOOP, pchar(@LoopBackFlag), SizeOf(LoopBackFlag));
    if sktRes = SOCKET_ERROR then
    begin
     Msg := Concat('Call to setsockopt failed! Error ', IntToStr(WSAGetLastError));
     Synchronize(DisplayMsg);
    end;
    Resume;
   end;

   procedure TSendMsgThrd.Execute;
   begin
   { Place thread code here }
    BlastMsg;
   end;

end.